home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byt86oct.arc / ALLOC.ARC / A1TEST.MOD next >
Text File  |  1985-07-12  |  4KB  |  185 lines
  1. MODULE alloc1test;
  2.  
  3. FROM Alloc1 IMPORT blockPtr, allocate, free, setWord, getWord, blockSize,
  4.     getFreeList;
  5. FROM MyTerminal IMPORT WriteString, Write, WriteLnString, WriteLn,
  6.     WriteCard, fatal, pause, ClearScreen, Read;
  7. FROM SYSTEM IMPORT WORD, ADDRESS;
  8. FROM InOut IMPORT ReadCard;
  9. FROM MachineSpecific IMPORT writeAddress;
  10.  
  11. CONST maxIndex = 32767;
  12.  
  13. TYPE bPtr = POINTER TO block;
  14.     block = RECORD
  15.          size:CARDINAL;
  16.          CASE BOOLEAN OF
  17.             TRUE: nextBlock: bPtr;
  18.          |  FALSE: contents:ARRAY[0..maxIndex] OF WORD;
  19.          END;
  20.          END;
  21.  
  22. VAR blockList:ARRAY['a'..'z'] OF blockPtr;
  23.  
  24. PROCEDURE rawPrintBlockHeader(blockp:bPtr);
  25. BEGIN
  26.     WriteLnString("---------------------");
  27.     IF ADDRESS(blockp) = NIL THEN
  28.     WriteLnString("NIL");
  29.     ELSE
  30.     WriteString("Block (raw) ");
  31.     writeAddress(ADDRESS(blockp));
  32.     WriteString("  (");
  33.     WriteCard(blockp^.size, 0); 
  34.     WriteLnString(" words)");
  35.     END;
  36. END rawPrintBlockHeader;
  37.  
  38. PROCEDURE rawPrintBlock(blockp:bPtr);
  39. VAR i:CARDINAL;
  40. BEGIN
  41.     rawPrintBlockHeader(blockp);
  42.     IF blockp <> NIL THEN
  43.     WITH blockp^ DO
  44.         FOR i := 0 TO size-1 DO
  45.         WriteCard(i, 3); WriteString(': ');
  46.         WriteCard(CARDINAL(contents[i]), 0); WriteLn;
  47.         END;
  48.     END;
  49.     END;
  50. END rawPrintBlock;
  51.  
  52. PROCEDURE printBlockHeader(blockp:blockPtr);
  53. BEGIN
  54.     WriteLnString("---------------------");
  55.     IF ADDRESS(blockp) = NIL THEN
  56.     WriteLnString("NIL");
  57.     ELSE
  58.     WriteString("Block ");
  59.     writeAddress(ADDRESS(blockp));
  60.     WriteString("  (");
  61.     WriteCard(blockSize(blockp), 0); 
  62.     WriteLnString(" words)");
  63.     END;
  64. END printBlockHeader; 
  65.  
  66. PROCEDURE printBlock(blockp:blockPtr);
  67. VAR i:CARDINAL;
  68. BEGIN
  69.     printBlockHeader(blockp);
  70.     IF ADDRESS(blockp) <> NIL THEN
  71.     FOR i := 0 TO blockSize(blockp)-1 DO
  72.         WriteCard(i, 3); WriteString(': ');
  73.         WriteCard(CARDINAL(getWord(blockp, i)), 0); WriteLn;
  74.     END;
  75.     END;
  76. END printBlock;
  77.  
  78. PROCEDURE rawPrintFreeList;
  79. VAR bp:bPtr;
  80. BEGIN
  81.     bp := bPtr(getFreeList());
  82.     WHILE bp <> NIL DO
  83.     rawPrintBlockHeader(bp);
  84.     bp := bp^.nextBlock;
  85.     END;
  86.     WriteLnString("---------------------");
  87. END rawPrintFreeList;
  88.  
  89. PROCEDURE printFreeList;
  90. VAR bp:blockPtr;
  91.     bptr:bPtr;
  92. BEGIN
  93.     bp := getFreeList();
  94.     WHILE ADDRESS(bp) <> NIL DO
  95.     printBlockHeader(bp);
  96.     bptr := bPtr(bp);
  97.     bp := blockPtr(bptr^.nextBlock);
  98.     END;
  99.     WriteLnString("---------------------");
  100. END printFreeList;
  101.  
  102. PROCEDURE test;
  103. VAR c1, c2:CHAR;
  104. BEGIN
  105.     LOOP
  106.     Write('>');
  107.     Read(c1); Write(c1);
  108.     Read(c2); Write(c2);
  109.     CASE c1 OF
  110.         'a': doAlloc(c2);
  111.     |   'f': doFree(c2);
  112.     |   'r': IF letter(c2) THEN 
  113.             rawPrintBlock(bPtr(blockList[c2]));
  114.          ELSE 
  115.             rawPrintFreeList;
  116.          END;
  117.     |   'p': IF letter(c2) THEN
  118.             printBlock(blockList[c2]);
  119.          ELSE 
  120.             printFreeList;
  121.          END;
  122.     |   's': doSet(c2);
  123.     |   'g': doGet(c2);
  124.     |   'q': EXIT;
  125.     ELSE
  126.     WriteLnString("a)lloc, f)ree, p)rint, r)aw print, qu)it, s)et, g)et");
  127.     END;
  128.     END;
  129. END test;
  130.    
  131. PROCEDURE doAlloc(b:CHAR);       
  132. BEGIN
  133.     blockList[b] := allocate(getCard("Number of words: "));
  134. END doAlloc;
  135.  
  136. PROCEDURE doFree(b:CHAR);
  137. BEGIN
  138.     free(blockList[b]);
  139. END doFree;
  140.  
  141. PROCEDURE doSet(b:CHAR);
  142. BEGIN
  143.     setWord(blockList[b], getCard("Position: "), getCard("Value: "));
  144. END doSet;
  145.  
  146. PROCEDURE doGet(b:CHAR);
  147. BEGIN
  148.     WriteCard(CARDINAL(getWord(blockList[b], getCard("Position: "))), 0);
  149. END doGet; 
  150.  
  151. PROCEDURE getCard(s:ARRAY OF CHAR):CARDINAL;
  152. VAR c:CARDINAL;
  153. BEGIN
  154.     WriteString(s);
  155.     ReadCard(c);
  156.     WriteLn;
  157.     RETURN c;
  158. END getCard;
  159.  
  160. PROCEDURE letter(c:CHAR):BOOLEAN;
  161. BEGIN
  162.     RETURN (c >= 'a') AND (c <= 'z');
  163. END letter;
  164.  
  165. PROCEDURE init;
  166. VAR c:CHAR;
  167. BEGIN
  168.     FOR c := 'a' TO 'z' DO
  169.     blockList[c] := blockPtr(NIL);
  170.     END;
  171. END init;
  172.  
  173. BEGIN
  174.     ClearScreen;
  175.     init;
  176.     test;
  177. END alloc1test.
  178. z' DO
  179.     blockList[c] := blockPtr(NIL);
  180.     END;
  181. END init;
  182.  
  183. BEGIN
  184.     ClearScreen;
  185.     ini